library(plotly)
Loading required package: ggplot2

Attaching package: <U+393C><U+3E31>plotly<U+393C><U+3E32>

The following object is masked from <U+393C><U+3E31>package:ggplot2<U+393C><U+3E32>:

    last_plot

The following object is masked from <U+393C><U+3E31>package:stats<U+393C><U+3E32>:

    filter

The following object is masked from <U+393C><U+3E31>package:graphics<U+393C><U+3E32>:

    layout
alfa = 15 * pi/180
Rotar15 = matrix(
  c(cos(alfa), -sin(alfa), 0,
    sin(alfa), cos(alfa), 0,
    0, 0, 1),
  nrow = 3,
  ncol = 3,
  byrow = TRUE
)
Estirar = matrix(
  c(4, 0, 0,
    0, 4, 0,
    0, 0, 1),
  nrow = 3,
  ncol = 3,
  byrow = TRUE
)
Mover = matrix(
  c(1, 0, 3,
    0, 1, 5,
    0, 0, 1),
  nrow = 3,
  ncol = 3,
  byrow = TRUE
)
calcularPuntos <- function(xy, transformaciones) {
  cuantos <- length(xy)
  x = xy[seq(1, cuantos, by = 2)] #Toma cada dos valores el primero (qe seria la x)
  y = xy[seq(2, cuantos, by = 2)] #Lo mismo pero con el segundo valor, qe es la y
  frame = rep(1, each = cuantos/2) #Los define como del primer frame
  
  xyAnterior = xy #Cada transformacion empieza en los xy qe dejo la anterior
  for (it in seq(1, length(transformaciones))) {
    rxy = c()
    for (i in seq(1, cuantos, by =2)) {
      p <- xyAnterior[i:(i+1)] #P tiene el i-esimo xy anterior
      r <- transformaciones[it][[1]] %*% append(p, 1) #Le aplico esta transformacion
      
      rxy <- append(rxy, r[1:2]) #Lo guardo para la proxima transformacion
      
      x <- append(x, r[1]) #Lo agrego para armar el dataframe de animar
      y <- append(y, r[2])
      frame <- append(frame, it+1)
    }
    xyAnterior <- rxy
  }
  df <- data.frame(
  x,
  y,
  frame
  )
  df
}
transformarYDibujar <- function(xy, transformaciones) {
  df <- calcularPuntos(xy, transformaciones)
  p <- ggplot(df) +
    geom_polygon(aes(frame = frame, x= x, y=y), color = "red")
   
  ggplotly(p, width = 600, height = 600) %>%
    animation_opts(1000)
}
transformacionesTodas = list(Estirar, Rotar15, Mover)
transformaciones1 = list(Rotar15, Rotar15, Rotar15, Estirar)
xycuadrado = c(1, 1, 1, 2, 4, 2, 4, 1) #x0, y0, x1, y1, x2, y2
transformarYDibujar(xycuadrado, transformaciones1)
Ignoring unknown aesthetics: frame
calcularEstrella <- function(n, r=1, rIntPct=50, alfa0grados=0, fill="blue") { #Me pasas la distancia de los puntos al centro; qe tanto qeres qe se hunda (en porcentaje de r) y la cantidad de puntos qe qeres qe dibuje
  alfa0 <- alfa0grados*pi/180
  
  x <- c() #Aca voy a ir guardando los valores de x e y
  y <- c()
  if (3 <= n) { #Revisa qe la estrella tenga tres o mas puntos
    rint <- r-(rIntPct*r/100) #Calculo con el porcentaje de hundimiento la distancia de los puntos internos al centro
    alfa <- 2*pi/n #Calcula la apertura entre dos extremidades
    for (i in 0:(n-1)) { #Puntos externos
      ex <- r*cos(i*alfa+alfa0) #Calcula la posicion de los puntos extremos
      ey <- r*sin(i*alfa+alfa0)
      
      x <- append(x, ex)
      y <- append(y, ey)
      #Puntos internos
      ix <- rint*cos((i+1/2)*alfa+alfa0) #Calcula la posicion de los puntos internos
      iy <- rint*sin((i+1/2)*alfa+alfa0) 
      
      x <- append(x, ix)
      y <- append(y, iy)
    }
  dfEst <- data.frame(
    x,
    y
    )
  } else {
    print("ERROR: No, no, no. Las estrellas tienen tres o mas puntos")
  }
}
dibujarEstrella <- function(n, r=1, rIntPct=50, alfa0=0) {
   dfEst <- calcularEstrella(n, r, rIntPct, alfa0, fill)
  dibujo <- ggplot(dfEst) +
    geom_polygon(aes(x = x, y=y), color = "red")
    if (n <= 100) {   
    ggplotly(dibujo, width = 600, height = 600) %>%
      animation_opts(1000)
  } else {
    print("Che, si pones tantos la PC anda medio mal, proba con menos")
  }
}
dibujarEstrella(70)
estrella1df <- calcularEstrella(16, 5)
estrella1xy <- c()
for (i in 1:length(estrella1df$x)) {
  estrella1xy <- append(estrella1xy, as.numeric(estrella1df[i, 1:2]))  
}
transformarYDibujar(estrella1xy, transformacionesTodas)
Ignoring unknown aesthetics: frame
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KYGBge3J9DQpsaWJyYXJ5KHBsb3RseSkNCmBgYA0KDQpgYGB7cn0NCmFsZmEgPSAxNSAqIHBpLzE4MA0KDQpSb3RhcjE1ID0gbWF0cml4KA0KICBjKGNvcyhhbGZhKSwgLXNpbihhbGZhKSwgMCwNCiAgICBzaW4oYWxmYSksIGNvcyhhbGZhKSwgMCwNCiAgICAwLCAwLCAxKSwNCiAgbnJvdyA9IDMsDQogIG5jb2wgPSAzLA0KICBieXJvdyA9IFRSVUUNCikNCmBgYA0KDQpgYGB7cn0NCkVzdGlyYXIgPSBtYXRyaXgoDQogIGMoNCwgMCwgMCwNCiAgICAwLCA0LCAwLA0KICAgIDAsIDAsIDEpLA0KICBucm93ID0gMywNCiAgbmNvbCA9IDMsDQogIGJ5cm93ID0gVFJVRQ0KKQ0KYGBgDQoNCmBgYHtyfQ0KTW92ZXIgPSBtYXRyaXgoDQogIGMoMSwgMCwgMywNCiAgICAwLCAxLCA1LA0KICAgIDAsIDAsIDEpLA0KICBucm93ID0gMywNCiAgbmNvbCA9IDMsDQogIGJ5cm93ID0gVFJVRQ0KKQ0KYGBgDQoNCmBgYHtyfQ0KY2FsY3VsYXJQdW50b3MgPC0gZnVuY3Rpb24oeHksIHRyYW5zZm9ybWFjaW9uZXMpIHsNCiAgY3VhbnRvcyA8LSBsZW5ndGgoeHkpDQogIHggPSB4eVtzZXEoMSwgY3VhbnRvcywgYnkgPSAyKV0gI1RvbWEgY2FkYSBkb3MgdmFsb3JlcyBlbCBwcmltZXJvIChxZSBzZXJpYSBsYSB4KQ0KICB5ID0geHlbc2VxKDIsIGN1YW50b3MsIGJ5ID0gMildICNMbyBtaXNtbyBwZXJvIGNvbiBlbCBzZWd1bmRvIHZhbG9yLCBxZSBlcyBsYSB5DQogIGZyYW1lID0gcmVwKDEsIGVhY2ggPSBjdWFudG9zLzIpICNMb3MgZGVmaW5lIGNvbW8gZGVsIHByaW1lciBmcmFtZQ0KICANCiAgeHlBbnRlcmlvciA9IHh5ICNDYWRhIHRyYW5zZm9ybWFjaW9uIGVtcGllemEgZW4gbG9zIHh5IHFlIGRlam8gbGEgYW50ZXJpb3INCiAgZm9yIChpdCBpbiBzZXEoMSwgbGVuZ3RoKHRyYW5zZm9ybWFjaW9uZXMpKSkgew0KICAgIHJ4eSA9IGMoKQ0KICAgIGZvciAoaSBpbiBzZXEoMSwgY3VhbnRvcywgYnkgPTIpKSB7DQogICAgICBwIDwtIHh5QW50ZXJpb3JbaTooaSsxKV0gI1AgdGllbmUgZWwgaS1lc2ltbyB4eSBhbnRlcmlvcg0KICAgICAgciA8LSB0cmFuc2Zvcm1hY2lvbmVzW2l0XVtbMV1dICUqJSBhcHBlbmQocCwgMSkgI0xlIGFwbGljbyBlc3RhIHRyYW5zZm9ybWFjaW9uDQogICAgICANCiAgICAgIHJ4eSA8LSBhcHBlbmQocnh5LCByWzE6Ml0pICNMbyBndWFyZG8gcGFyYSBsYSBwcm94aW1hIHRyYW5zZm9ybWFjaW9uDQogICAgICANCiAgICAgIHggPC0gYXBwZW5kKHgsIHJbMV0pICNMbyBhZ3JlZ28gcGFyYSBhcm1hciBlbCBkYXRhZnJhbWUgZGUgYW5pbWFyDQogICAgICB5IDwtIGFwcGVuZCh5LCByWzJdKQ0KICAgICAgZnJhbWUgPC0gYXBwZW5kKGZyYW1lLCBpdCsxKQ0KICAgIH0NCiAgICB4eUFudGVyaW9yIDwtIHJ4eQ0KICB9DQogIGRmIDwtIGRhdGEuZnJhbWUoDQogIHgsDQogIHksDQogIGZyYW1lDQogICkNCiAgZGYNCn0NCg0KdHJhbnNmb3JtYXJZRGlidWphciA8LSBmdW5jdGlvbih4eSwgdHJhbnNmb3JtYWNpb25lcykgew0KICBkZiA8LSBjYWxjdWxhclB1bnRvcyh4eSwgdHJhbnNmb3JtYWNpb25lcykNCiAgcCA8LSBnZ3Bsb3QoZGYpICsNCiAgICBnZW9tX3BvbHlnb24oYWVzKGZyYW1lID0gZnJhbWUsIHg9IHgsIHk9eSksIGNvbG9yID0gInJlZCIpDQogICANCiAgZ2dwbG90bHkocCwgd2lkdGggPSA2MDAsIGhlaWdodCA9IDYwMCkgJT4lDQogICAgYW5pbWF0aW9uX29wdHMoMTAwMCkNCn0NCmBgYA0KDQpgYGB7cn0NCnRyYW5zZm9ybWFjaW9uZXNUb2RhcyA9IGxpc3QoRXN0aXJhciwgUm90YXIxNSwgTW92ZXIpDQpgYGANCg0KYGBge3J9DQp0cmFuc2Zvcm1hY2lvbmVzMSA9IGxpc3QoUm90YXIxNSwgUm90YXIxNSwgUm90YXIxNSwgRXN0aXJhcikNCnh5Y3VhZHJhZG8gPSBjKDEsIDEsIDEsIDIsIDQsIDIsIDQsIDEpICN4MCwgeTAsIHgxLCB5MSwgeDIsIHkyDQoNCnRyYW5zZm9ybWFyWURpYnVqYXIoeHljdWFkcmFkbywgdHJhbnNmb3JtYWNpb25lczEpDQpgYGANCg0KYGBge3J9DQpjYWxjdWxhckVzdHJlbGxhIDwtIGZ1bmN0aW9uKG4sIHI9MSwgckludFBjdD01MCwgYWxmYTBncmFkb3M9MCwgZmlsbD0iYmx1ZSIpIHsgI01lIHBhc2FzIGxhIGRpc3RhbmNpYSBkZSBsb3MgcHVudG9zIGFsIGNlbnRybzsgcWUgdGFudG8gcWVyZXMgcWUgc2UgaHVuZGEgKGVuIHBvcmNlbnRhamUgZGUgcikgeSBsYSBjYW50aWRhZCBkZSBwdW50b3MgcWUgcWVyZXMgcWUgZGlidWplDQogIGFsZmEwIDwtIGFsZmEwZ3JhZG9zKnBpLzE4MA0KICANCiAgeCA8LSBjKCkgI0FjYSB2b3kgYSBpciBndWFyZGFuZG8gbG9zIHZhbG9yZXMgZGUgeCBlIHkNCiAgeSA8LSBjKCkNCg0KICBpZiAoMyA8PSBuKSB7ICNSZXZpc2EgcWUgbGEgZXN0cmVsbGEgdGVuZ2EgdHJlcyBvIG1hcyBwdW50b3MNCiAgICByaW50IDwtIHItKHJJbnRQY3Qqci8xMDApICNDYWxjdWxvIGNvbiBlbCBwb3JjZW50YWplIGRlIGh1bmRpbWllbnRvIGxhIGRpc3RhbmNpYSBkZSBsb3MgcHVudG9zIGludGVybm9zIGFsIGNlbnRybw0KICAgIGFsZmEgPC0gMipwaS9uICNDYWxjdWxhIGxhIGFwZXJ0dXJhIGVudHJlIGRvcyBleHRyZW1pZGFkZXMNCg0KICAgIGZvciAoaSBpbiAwOihuLTEpKSB7ICNQdW50b3MgZXh0ZXJub3MNCiAgICAgIGV4IDwtIHIqY29zKGkqYWxmYSthbGZhMCkgI0NhbGN1bGEgbGEgcG9zaWNpb24gZGUgbG9zIHB1bnRvcyBleHRyZW1vcw0KICAgICAgZXkgPC0gcipzaW4oaSphbGZhK2FsZmEwKQ0KICAgICAgDQogICAgICB4IDwtIGFwcGVuZCh4LCBleCkNCiAgICAgIHkgPC0gYXBwZW5kKHksIGV5KQ0KDQogICAgICAjUHVudG9zIGludGVybm9zDQogICAgICBpeCA8LSByaW50KmNvcygoaSsxLzIpKmFsZmErYWxmYTApICNDYWxjdWxhIGxhIHBvc2ljaW9uIGRlIGxvcyBwdW50b3MgaW50ZXJub3MNCiAgICAgIGl5IDwtIHJpbnQqc2luKChpKzEvMikqYWxmYSthbGZhMCkgDQogICAgICANCiAgICAgIHggPC0gYXBwZW5kKHgsIGl4KQ0KICAgICAgeSA8LSBhcHBlbmQoeSwgaXkpDQogICAgfQ0KICBkZkVzdCA8LSBkYXRhLmZyYW1lKA0KICAgIHgsDQogICAgeQ0KICAgICkNCiAgfSBlbHNlIHsNCiAgICBwcmludCgiRVJST1I6IE5vLCBubywgbm8uIExhcyBlc3RyZWxsYXMgdGllbmVuIHRyZXMgbyBtYXMgcHVudG9zIikNCiAgfQ0KfQ0KDQpkaWJ1amFyRXN0cmVsbGEgPC0gZnVuY3Rpb24obiwgcj0xLCBySW50UGN0PTUwLCBhbGZhMD0wKSB7DQoNCiAgIGRmRXN0IDwtIGNhbGN1bGFyRXN0cmVsbGEobiwgciwgckludFBjdCwgYWxmYTAsIGZpbGwpDQoNCiAgZGlidWpvIDwtIGdncGxvdChkZkVzdCkgKw0KICAgIGdlb21fcG9seWdvbihhZXMoeCA9IHgsIHk9eSksIGNvbG9yID0gInJlZCIpDQoNCiAgICBpZiAobiA8PSAxMDApIHsgICANCiAgICBnZ3Bsb3RseShkaWJ1am8sIHdpZHRoID0gNjAwLCBoZWlnaHQgPSA2MDApICU+JQ0KICAgICAgYW5pbWF0aW9uX29wdHMoMTAwMCkNCiAgfSBlbHNlIHsNCiAgICBwcmludCgiQ2hlLCBzaSBwb25lcyB0YW50b3MgbGEgUEMgYW5kYSBtZWRpbyBtYWwsIHByb2JhIGNvbiBtZW5vcyIpDQogIH0NCn0NCg0KZGlidWphckVzdHJlbGxhKDcwKQ0KYGBgDQpgYGB7cn0NCmVzdHJlbGxhMWRmIDwtIGNhbGN1bGFyRXN0cmVsbGEoMTYsIDUpDQplc3RyZWxsYTF4eSA8LSBjKCkNCg0KZm9yIChpIGluIDE6bGVuZ3RoKGVzdHJlbGxhMWRmJHgpKSB7DQogIGVzdHJlbGxhMXh5IDwtIGFwcGVuZChlc3RyZWxsYTF4eSwgYXMubnVtZXJpYyhlc3RyZWxsYTFkZltpLCAxOjJdKSkgIA0KfQ0KDQp0cmFuc2Zvcm1hcllEaWJ1amFyKGVzdHJlbGxhMXh5LCB0cmFuc2Zvcm1hY2lvbmVzVG9kYXMpDQpgYGANCg==